Viajes más Frecuentes
En esta parte, utilizaremos los datos de Origen y Destino y la frecuencia de de viaje de un lugar a otro, es decir la cantidad de veces que un Origen esta relacionado con un Destino.
Para esto, vamos a utilizar grafos, y los visualizaremos tanto con grafos dirigidos como grafos no dirigidos. Estos se ara con las librerias del paquete ggraph.
# Corro las librerias necesarias
library(ggraph)
library(ggplot2)
# library(ggthemes)
library(dplyr)
library(igraph)
# Leo el csv con los datos
df.vuelos <- read.csv("./csv/vuelos_2021.csv")
df.vuelos
El dataset ya esta ordenado por Origen y Destino.
Ahora, añadimos una columna contando la frecuencias de estos viajes.
frec.viajes <- df.vuelos %>% select(Origen, Destino) %>% group_by(Origen,Destino) %>% summarise(n=n())
`summarise()` has grouped output by 'Origen'. You can override using the `.groups` argument.
frec.viajes
Habiendo tomado las freciencias de los viajes segun origen y destino, ya tenemos la información necesaria para podes visualizar lo que pasa con algun tipo de grafo.
Grafo NO dirigido
Tomemos los datos y produscamos un grafo no dirigido donde el ancho del hilo de unión entre dos aeropuertos represente la cantidad de vuelos que hay entre estos dos aeropuertos.
# Tomo el dataframe del grafo y pido que no sea dirigido
grafo <- graph.data.frame(frec.viajes, directed = F)
plot.igraph( grafo,
vertex.frame.color = "Forestgreen",
vertex.size=degree(grafo, mode = "out"),
vertex.label.cex=c(2,2.5,3),
vertex.label.dist=0,
edge.color="black",
edge.curved = F,
edge.width = E(grafo)/30)

En el grafo se puede visualizar que la mayoria de los viajes salen o de EZE o de AER. Entonces, tendria sentido preguntarse si hay alguna diferencia entre los vuelos que salen de EZE (o llegan) y los de AER.
Tomemos dos dos dataframes distintos, uno con los origenes en EZE y otro en AER
graph <- graph_from_data_frame(frec.viajes)
ggraph(graph, layout = 'kk') + geom_edge_link(aes(colour = factor(n))) + geom_node_point()

layout <- create_layout(graph, layout = 'drl')
dendrogram <- as.dendrogram(hclust(dist(frec.viajes$n)))
ggraph(dendrogram, 'dendrogram') +
geom_edge_elbow()

NA
NA
Hagamos el primer grafo, pero tomando un origen y viendo que pasa con cada uno de estos.
grafica.grafo.origen <- function(df, filtro){
# Filtra el dataset
dt <- df %>% filter(Origen == filtro)
# crea el grafo
gf <- graph.data.frame(dt, directed = F)
# Dibuja el grafo
plot.igraph( gf,
vertex.frame.color = "Forestgreen",
vertex.label.cex=c(1.5,1,0.5),
vertex.label.dist=0,
edge.color="black",
edge.curved = F,
edge.width = E(gf)/30)
}
nombres <- names(table(frec.viajes$Origen))
for (i in (1:4)){
grafica.grafo.origen(frec.viajes, nombres[i])
}




NA
NA
NA
LS0tDQp0aXRsZTogIlRQIC0gIEFlcm9wdWVydG9zIg0KYXV0aG9yOiAiR3J1cG8gODogIENvc2FyaW5za3kgTWF0aWFzLCBSZW11cyBFemVxdWllbCwgUmV5ZXMgQW5kcmVzICINCmRhdGU6ICIiDQpvdXRwdXQ6DQogIGh0bWxfZG9jdW1lbnQ6DQogICAgZGZfcHJpbnQ6IHBhZ2VkDQogICAgdG9jOiB5ZXMNCiAgaHRtbF9ub3RlYm9vazoNCiAgICB0aGVtZTogam91cm5hbA0KICAgIHRvYzogeWVzDQogICAgdG9jX2Zsb2F0OiB5ZXMNCiAgcGRmX2RvY3VtZW50Og0KICAgIHRvYzogeWVzDQpzdWJ0aXRsZTogTGFib3JhdG9yaW8gZGUgRGF0b3MNCi0tLQ0KPHN0eWxlIHR5cGU9InRleHQvY3NzIj4NCi50aXRsZSB7DQogIGRpc3BsYXk6IG5vbmU7DQp9DQoNCiNnZXR0aW5nLXN0YXJ0ZWQgaW1nIHsNCiAgbWFyZ2luLXJpZ2h0OiAxMHB4Ow0KfQ0KDQo8L3N0eWxlPg0KDQpgYGB7ciBzZXR1cCwgaW5jbHVkZT1GQUxTRX0NCmtuaXRyOjpvcHRzX2NodW5rJHNldChjb2xsYXBzZSA9IFRSVUUpDQpgYGANCiMgVmlhamVzIG3DoXMgRnJlY3VlbnRlcw0KDQpFbiBlc3RhIHBhcnRlLCB1dGlsaXphcmVtb3MgbG9zIGRhdG9zIGRlIGBPcmlnZW5gIHkgYERlc3Rpbm9gIHkgbGEgZnJlY3VlbmNpYSBkZSBkZSB2aWFqZSANCmRlIHVuIGx1Z2FyIGEgb3RybywgZXMgZGVjaXIgbGEgY2FudGlkYWQgZGUgdmVjZXMgcXVlIHVuICBgT3JpZ2VuYCBlc3RhIHJlbGFjaW9uYWRvIGNvbiB1biBgRGVzdGlub2AuDQoNClBhcmEgZXN0bywgdmFtb3MgYSB1dGlsaXphciBncmFmb3MsIHkgbG9zIHZpc3VhbGl6YXJlbW9zIHRhbnRvIGNvbiBncmFmb3MgZGlyaWdpZG9zIGNvbW8gZ3JhZm9zIG5vIGRpcmlnaWRvcy4gRXN0b3Mgc2UgYXJhIGNvbiBsYXMgbGlicmVyaWFzIGRlbCBwYXF1ZXRlIGBnZ3JhcGhgLg0KDQoNCmBgYHtyfQ0KIyBDb3JybyBsYXMgbGlicmVyaWFzIG5lY2VzYXJpYXMNCmxpYnJhcnkoZ2dyYXBoKQ0KbGlicmFyeShnZ3Bsb3QyKQ0KIyBsaWJyYXJ5KGdndGhlbWVzKQ0KbGlicmFyeShkcGx5cikNCmxpYnJhcnkoaWdyYXBoKQ0KDQojIExlbyBlbCBjc3YgY29uIGxvcyBkYXRvcw0KZGYudnVlbG9zIDwtIHJlYWQuY3N2KCIuL2Nzdi92dWVsb3NfMjAyMS5jc3YiKQ0KDQpkZi52dWVsb3MNCmBgYA0KDQpFbCBgZGF0YXNldGAgeWEgZXN0YSBvcmRlbmFkbyBwb3IgKk9yaWdlbiogeSAqRGVzdGlubyouDQoNCkFob3JhLCBhw7FhZGltb3MgdW5hIGNvbHVtbmEgY29udGFuZG8gbGEgZnJlY3VlbmNpYXMgZGUgZXN0b3MgdmlhamVzLg0KDQpgYGB7cn0NCmZyZWMudmlhamVzIDwtIGRmLnZ1ZWxvcyAlPiUgc2VsZWN0KE9yaWdlbiwgRGVzdGlubykgJT4lIGdyb3VwX2J5KE9yaWdlbixEZXN0aW5vKSAlPiUgc3VtbWFyaXNlKG49bigpKQ0KZnJlYy52aWFqZXMNCmBgYA0KDQpIYWJpZW5kbyB0b21hZG8gbGFzIGZyZWNpZW5jaWFzIGRlIGxvcyB2aWFqZXMgc2VndW4gb3JpZ2VuIHkgZGVzdGlubywgeWEgdGVuZW1vcyBsYSBpbmZvcm1hY2nDs24gbmVjZXNhcmlhIHBhcmEgcG9kZXMgdmlzdWFsaXphciBsbyBxdWUgcGFzYSBjb24gYWxndW4gdGlwbyBkZSBncmFmby4NCg0KIyMgR3JhZm8gTk8gZGlyaWdpZG8NCg0KVG9tZW1vcyBsb3MgZGF0b3MgeSBwcm9kdXNjYW1vcyB1biBncmFmbyBubyBkaXJpZ2lkbyBkb25kZSBlbCBhbmNobyBkZWwgaGlsbyBkZSB1bmnDs24gZW50cmUNCmRvcyBhZXJvcHVlcnRvcyByZXByZXNlbnRlIGxhIGNhbnRpZGFkIGRlIHZ1ZWxvcyBxdWUgaGF5IGVudHJlIGVzdG9zIGRvcyBhZXJvcHVlcnRvcy4NCg0KYGBge3IgIEZpZzEsIGVjaG89VFJVRSwgZmlnLmhlaWdodD0zMCwgZmlnLndpZHRoPTMwfQ0KIyBUb21vIGVsIGRhdGFmcmFtZSBkZWwgZ3JhZm8geSBwaWRvIHF1ZSBubyBzZWEgZGlyaWdpZG8NCmdyYWZvIDwtIGdyYXBoLmRhdGEuZnJhbWUoZnJlYy52aWFqZXMsIGRpcmVjdGVkID0gRikNCg0KDQpwbG90LmlncmFwaCggZ3JhZm8sIA0KICAgICAgICAgICAgIHZlcnRleC5mcmFtZS5jb2xvciA9ICJGb3Jlc3RncmVlbiIsDQogICAgICAgICAgICAgdmVydGV4LnNpemU9ZGVncmVlKGdyYWZvLCBtb2RlID0gIm91dCIpLA0KICAgICAgICAgICAgIHZlcnRleC5sYWJlbC5jZXg9YygyLDIuNSwzKSwgDQogICAgICAgICAgICAgdmVydGV4LmxhYmVsLmRpc3Q9MCwNCiAgICAgICAgICAgICBlZGdlLmNvbG9yPSJibGFjayIsDQogICAgICAgICAgICAgZWRnZS5jdXJ2ZWQgPSBGLCANCiAgICAgICAgICAgICBlZGdlLndpZHRoID0gRShncmFmbykvMzApDQoNCmBgYA0KDQpFbiBlbCBncmFmbyBzZSBwdWVkZSB2aXN1YWxpemFyIHF1ZSBsYSBtYXlvcmlhIGRlIGxvcyB2aWFqZXMgc2FsZW4gbyBkZSBgRVpFYCBvIGRlIGBBRVJgLiBFbnRvbmNlcywgdGVuZHJpYSBzZW50aWRvIHByZWd1bnRhcnNlIHNpIGhheSBhbGd1bmEgZGlmZXJlbmNpYSBlbnRyZSBsb3MgdnVlbG9zIHF1ZSBzYWxlbiBkZSBgRVpFYCAobyBsbGVnYW4pIHkgbG9zIGRlIGBBRVJgLg0KDQpUb21lbW9zIGRvcyBkb3MgZGF0YWZyYW1lcyBkaXN0aW50b3MsIHVubyBjb24gbG9zIG9yaWdlbmVzIGVuIGBFWkVgIHkgb3RybyBlbiBgQUVSYA0KDQoNCg0KYGBge3J9DQpncmFwaCA8LSBncmFwaF9mcm9tX2RhdGFfZnJhbWUoZnJlYy52aWFqZXMpDQpnZ3JhcGgoZ3JhcGgsIGxheW91dCA9ICdraycpICsgIGdlb21fZWRnZV9saW5rKGFlcyhjb2xvdXIgPSBmYWN0b3IobikpKSArIGdlb21fbm9kZV9wb2ludCgpDQpgYGANCg0KDQpgYGB7cn0NCmxheW91dCA8LSBjcmVhdGVfbGF5b3V0KGdyYXBoLCBsYXlvdXQgPSAnZHJsJykNCg0KZGVuZHJvZ3JhbSA8LSBhcy5kZW5kcm9ncmFtKGhjbHVzdChkaXN0KGZyZWMudmlhamVzJG4pKSkNCmdncmFwaChkZW5kcm9ncmFtLCAnZGVuZHJvZ3JhbScpICsgDQogICAgZ2VvbV9lZGdlX2VsYm93KCkNCg0KDQpgYGANCg0KDQpIYWdhbW9zIGVsIHByaW1lciBncmFmbywgcGVybyB0b21hbmRvIHVuIG9yaWdlbiB5IHZpZW5kbyBxdWUgcGFzYSBjb24gY2FkYSB1bm8gZGUgZXN0b3MuDQoNCmBgYHtyfQ0KIyMgTGEgaWRlYSBkZSBlc3RlIGNvZGlnbyBlcyBxdWUgY3VhbmRvIHVzdGVkZXMgbG8gdGVuZ2FuIGEgbWFubw0KIyMgc2kgb3VlZGVuIGNvcnJlcmxvIGNvbiAsIGZpZy5zaG93PSdhbmltYXRlJyBvdWVkYW4gdmVyIGxhIA0KIyMgU2VjdWVuY2lhIGRlIGNvbW8gZXN0YSBjYWRhIHVubyByZWxhY2lvbmFkbyBjb24gdG9kb3MuDQojIyBBIG1pIG1lIGZhbHRvIHRlbmVyIGluc3RhbGFkbyBmZm1lcCBlbiB3aW5kb3dzIGNvc2EgDQojIyBxdWUgc2UgbWUgY29tcGxpY28gaW5zdGFsYXINCmdyYWZpY2EuZ3JhZm8ub3JpZ2VuIDwtIGZ1bmN0aW9uKGRmLCBmaWx0cm8pew0KICAjIEZpbHRyYSBlbCBkYXRhc2V0ICANCiAgZHQgPC0gZGYgJT4lIGZpbHRlcihPcmlnZW4gPT0gZmlsdHJvKQ0KICAjIGNyZWEgZWwgZ3JhZm8NCiAgZ2YgPC0gZ3JhcGguZGF0YS5mcmFtZShkdCwgZGlyZWN0ZWQgPSBGKQ0KICANCiAgIyBEaWJ1amEgZWwgZ3JhZm8NCiAgcGxvdC5pZ3JhcGgoIGdmLCANCiAgICAgICAgICAgICB2ZXJ0ZXguZnJhbWUuY29sb3IgPSAiRm9yZXN0Z3JlZW4iLA0KICAgICAgICAgICAgIHZlcnRleC5sYWJlbC5jZXg9YygxLjUsMSwwLjUpLCANCiAgICAgICAgICAgICB2ZXJ0ZXgubGFiZWwuZGlzdD0wLA0KICAgICAgICAgICAgIGVkZ2UuY29sb3I9ImJsYWNrIiwNCiAgICAgICAgICAgICBlZGdlLmN1cnZlZCA9IEYsIA0KICAgICAgICAgICAgIGVkZ2Uud2lkdGggPSBFKGdmKS8zMCkNCiAgfQ0KDQpub21icmVzIDwtIG5hbWVzKHRhYmxlKGZyZWMudmlhamVzJE9yaWdlbikpDQoNCmZvciAoaSBpbiAoMTo0KSl7DQogIGdyYWZpY2EuZ3JhZm8ub3JpZ2VuKGZyZWMudmlhamVzLCBub21icmVzW2ldKSAgDQp9DQoNCg0KDQpgYGANCg0KDQoNCg0KDQoNCg0KDQoNCg0KDQo=